Option Explicit
Option Compare Text
'Mise a jour de la feuille Transfert
Sub maj_Transfert()
'Noms a ne pas changer : GROS OEUVRES
'Macro Dan - 15/06/17
 '19/10/17 - mise en place de formules aprs ligne 15 pour calcul Totaux sous traitance et recopie  droite - Ajout 19/10/17 - Dan
Dim LigDet As Integer, LigTrf As Integer
Dim CouleurVf As String, CouleurVm As String, CouleurVc As String, CouleurB As String, CouleurJ As String
Dim i As Byte, j As Byte, DclTrf As Byte, k As Byte

'On determine la couleur du fond.
CouleurVf = 11581042 'couleur de fond vert fonce
CouleurVm = 12897954  'couleur de fond vert moyen
CouleurVc = 14739672 'couleur de font vert clair
CouleurB = 16777215 'couleur de fond blanc
'CouleurJ = 9238015 'couleur de fond jaune sous MAC
CouleurJ = 13434879 'couleur de fond jaune sous windows

With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

With Sheets("Transfert")
    .Unprotect 'deproteger la feuille Transfert
    DclTrf = .Cells(9, .Columns.Count).End(xlToLeft).Column 'derniere colonne
End With
'Mise a Jour depuis la feuille Synthese DS - TOTAL PRODUCTION PROPRE

Dim LigSTds As Byte
Dim temp As String ', lig

LigTrf = 10
For i = LigTrf To LigTrf + 3 'ligne 10 a 13
    With Sheets("Transfert")
        On Error Resume Next
        LigSTds = Sheets("SYNTHESE DS").Range("A:A").Find(.Range("A" & i), LookIn:=xlValues).Row 'Recherche dans la feuille SyntheseDS
        If Err > 0 Then MsgBox "La donnee " & .Range("A" & i) & " n'existe pas dans la feuille Synthese DS ou est mal orthographiee !": .Range("C" & i) = 0
        '.Range(.Cells(i, 3), .Cells(i, DclTrf - 1)).ClearContents 'desactive le 12/10 pour eviter la suppression des donnees lignes 10 et suivantes - Dan
        .Range("C" & i) = Sheets("SYNTHESE DS").Range("D" & LigSTds)
    End With
Next i
On Error GoTo 0

'Mise a Jour depuis la feuille DETAILS - TOTAL SOUS TRAITANCE
LigTrf = 15
LigDet = Sheets("DETAILS").Range("B:B").Find("SOUS TRAITANCE", LookIn:=xlValues).Row + 1 'Recherche mot Sous traitance dans la feuille Details
'j = 0
While Sheets("DETAILS").Range("B" & LigDet).Interior.Color <> CouleurVf
    With Sheets("Transfert")
        Select Case Sheets("DETAILS").Range("B" & LigDet).Interior.Color
            
            Case Is = CouleurVm
                .Range("A" & LigTrf) = "ST " & Sheets("DETAILS").Range("B" & LigDet)
                .Range("C" & LigTrf) = Sheets("DETAILS").Range("C" & LigDet)
                .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf - 1)).ClearContents 'desactive le 12/10 pour eviter la suppression des donnees lignes 15 et suivantes - Dan
                .Cells(LigTrf, DclTrf).FormulaR1C1 = "=SUM(R[" & LigTrf - 15 - j & "]C[-1]:R[" & LigTrf - 15 - j & "]C[-18])"
                 With .Range("A" & LigTrf)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Font.Bold = True
                End With
                With .Range(.Cells(LigTrf, 3), .Cells(LigTrf, DclTrf))
                    .HorizontalAlignment = xlRight
                    .VerticalAlignment = xlCenter
                    .Font.Bold = True
                End With
                LigTrf = LigTrf + 1
                j = j + 1
                k = 0 'Ajout 19/10/17 - Dan
            Case Is = CouleurVc
                .Range("A" & LigTrf) = Sheets("DETAILS").Range("B" & LigDet)
                .Range("C" & LigTrf) = Sheets("DETAILS").Range("C" & LigDet)
                .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf - 1)).ClearContents 'desactive le 12/10 pour eviter la suppression des lignes 15 et suivantes - Dan
                .Cells(LigTrf, DclTrf).FormulaR1C1 = "=SUM(RC[-18]:RC[-1])"

                With .Range("A" & LigTrf)
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                    .Font.Bold = False
                End With
                With .Range("C" & LigTrf)
                    .HorizontalAlignment = xlRight
                    .VerticalAlignment = xlCenter
                    .Font.Bold = False
                End With
                With .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf))
                    .HorizontalAlignment = xlRight
                    .VerticalAlignment = xlCenter
                    .Font.Bold = False
                End With
                
                LigTrf = LigTrf + 1
                j = j + 1
                k = k + 1 'ajout 19/10/17 -  Dan
        End Select

        LigDet = LigDet + 1
        If .Range("A" & LigTrf).Interior.Color = CouleurJ And Sheets("DETAILS").Range("B" & LigDet).Interior.Color <> CouleurVf Then .Rows(LigTrf).Insert Shift:=xlDown
        'mise en place de formule aprs ligne 15 et recopie  droite - Ajout 19/10/17 - Dan
         If k > 0 Then .Cells(LigTrf - 1 - k, 4).FormulaR1C1 = "=SUM(R[" & k & "]C:R[1]C[])": .Cells(LigTrf - 1 - k, 4).AutoFill Destination:=.Range("D" & LigTrf - 1 - k & ":T" & LigTrf - 1 - k), Type:=xlFillDefault
    End With
Wend

With Sheets("Transfert")
    While .Range("A" & LigTrf).Interior.Color <> CouleurJ
        .Rows(LigTrf).Delete
    Wend
    
    For i = 15 To LigTrf - 1
        If .Range("C" & i).Font.Bold = True Then
            If temp = "" Then temp = "R[" & i - LigTrf & "]C" Else: temp = temp & "+R[" & i - LigTrf & "]C"
        End If
    Next i
    .Range("C" & LigTrf) = "=" & temp & ""
    .Range("C" & LigTrf).Copy .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf - 1)) 'Formule Total Sous Traitance
End With

'Mise a Jour depuis la feuille RECAP IND - Total les indirects
LigTrf = LigTrf + 1
Dim dlgRind As Byte

j = LigTrf
dlgRind = Sheets("RECAP IND").Range("A" & Sheets("RECAP IND").Rows.Count).End(xlUp).Row

For i = 12 To dlgRind - 1
    With Sheets("Transfert")
        '.Range("C" & LigTrf & ":T" & LigTrf).ClearContents'desactive le 12/10 pour eviter la suppression des lignes 10 et suivantes - Dan
        .Range("A" & LigTrf) = Sheets("RECAP IND").Range("A" & i)
        .Range("C" & LigTrf) = Sheets("RECAP IND").Range("B" & i)
        .Cells(LigTrf, DclTrf).FormulaR1C1 = "=SUM(RC[-18]:RC[-1])"
        With .Range("A" & LigTrf)
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlCenter
            .Font.Bold = False
        End With
        With .Range("C" & LigTrf)
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .Font.Bold = False
        End With
        With .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf))
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .Font.Bold = False
        End With
        LigTrf = LigTrf + 1
        If .Range("A" & LigTrf).Interior.Color = CouleurJ And i <> dlgRind - 1 Then .Rows(LigTrf).Insert Shift:=xlDown
    End With
Next i


With Sheets("Transfert")
    While .Range("A" & LigTrf).Interior.Color <> CouleurJ
        .Rows(LigTrf).Delete
    Wend
    
    .Range("C" & LigTrf).FormulaR1C1 = "=SUM(R[" & j - LigTrf & "]C:R[" & -1 & "]C)" 'Formule Total Les Indirects
    .Range("C" & LigTrf).Copy .Range(.Cells(LigTrf, 4), .Cells(LigTrf, DclTrf))
    .Range("C" & LigTrf + 1) = "=R14C+R[" & LigTrf - LigTrf - 1 & "]C" & "+R[" & j - LigTrf - 2 & "]C" 'Formule Total Production Propre
    .Range("C" & LigTrf + 1).Copy .Range(.Cells(LigTrf + 1, 4), .Cells(LigTrf + 1, DclTrf - 1))
    
'Mise a jour depuis feuille DCH
Dim LigDch As Byte
    LigTrf = LigTrf + 5
    LigDch = Sheets("DCH").Range("B:C").Find("RISQUES TECHNIQUES IDENTIFIES", LookIn:=xlValues).Row
    For i = 0 To 1
        '.Range(.Cells(LigTrf + i, 1), .Cells(LigTrf + i, DclTrf)).ClearContents 'desactive le 12/10 pour eviter la suppression des lignes 52 et 53 - Dan
        .Range("A" & LigTrf + i) = Sheets("DCH").Range("B" & LigDch + i)
        .Range("C" & LigTrf + i) = Sheets("DCH").Range("F" & LigDch + i)
    Next i
    
    With .Range(.Cells(8, DclTrf), .Cells(LigTrf + 3, DclTrf)).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        '.ColorIndex = xlAutomatic
        .Weight = xlThin
    End With

    .Protect 'proteger la feuille Transfert
End With
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

